perm filename FILLER.ZLD[MSS,LCS] blob sn#096347 filedate 1974-04-05 generic text, type T, neo UTF8
00010		SUBROUTINE FILLER
00110		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00123		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00136		COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00150		REAL LF
00200		COMMON Q(200),R(200),E(200),NN
00210		COMMON/LL/L
00300		DIMENSION P(50)
00600	
01310		RR=RSZ
01320		IF(IXRX)RSZ=RSZ*1.7
01330	C  FOR XGP
01400		KK=0
01410		A=1000
01420		B=-1000
01430		D=-1000
01440		C=1000
01490	206	DO 205 J=IC,MCLEF(1)
01500		CALL UNPACK(J,M,N,MCLEF)
01505		KK=KK+1
01510		E(KK)=0
01520		IF(L.GE.100000000)E(KK)=-1
01530	208	Q(KK)=(M+RJB)*RSZ
01535		IF(Q(KK).LT.A)A=Q(KK)
01537		IF(Q(KK).GT.B)B=Q(KK)
01540		R(KK)=(N+CENTR)*RSZ
01550		IF(R(KK).LT.C)C=R(KK)
01560	205	IF(R(KK).GT.D)D=R(KK)
01590		RSZ=1
01600		GO TO 201
01690	400	DO 40 K=1,KK
01695		J=2
01700		IF(E(K))J=3
01800	40	CALL LINES(Q(K),R(K),J)
01900	201	N=1
02000	4	J=0
02010		CALL DPYOUT(1)
02100	CC	H=-1000
02110		M=4
02120		IF(IXRX)M=2
02200		Z=-1000
02250	
02300		DO 1 K=IFIX(A),IFIX(B),M
02400		G=K
02600		Y=1000
02700		KJ=0
02750	44	Z=-1000
02760	
02800		DO 45 J=2,KK
02810		IF(E(J))GO TO 45
02900		QB=Q(J)
03000		QA=Q(J-1)
03100		IF(QA.EQ.QB)GO TO 45
03200		IF((G.EQ.QA.OR.G.EQ.QB).AND.Y.NE.-1000)GO TO 1
03400	46	IF(((G.GT.QB.OR.G.LT.QA).AND.QB.GT.QA).OR.((G.LT.QB.OR.G.GT.QA)
03450		1.AND.QA.GT.QB))GO TO 45
03500	C  MISSES LINES
03600		X=HGHT(R(J),R(J-1),G,Q(J-1),Q(J))
03700		IF(X.LE.Z.OR.X.GE.Y)GO TO 45
03800		Z=X
03900	45	CONTINUE
04000		IF(Z.EQ.-1000)GO TO 47
04100	49	KJ=KJ+1
04200		P(KJ)=Z
04300		Y=Z
04400	C  RESETS TOP AND BOTTOM
04500		GO TO 44
04600	47	IF(KJ.LE.1)GO TO 1
04700		IF(MOD(KJ,2).NE.0)KJ=KJ-1
04800		DO 48 L=1,KJ,2
04900		CALL LINES(FLOAT(K),P(L),3)
05100	48	CALL LINES(FLOAT(K),P(L+1),2)
05200		CALL DPYOUT(1)
05300	1	CONTINUE
06000		RSZ=RR
12000		END
13000		
13100		FUNCTION HGHT(A,B,C,D,E)
13200		HGHT=((A-B)*(C-D))/(E-D)+B
13250		IF(E.EQ.D)HGHT=B
13300		END